home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue63 / Clinic / SysIconU.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-09-09  |  3.5 KB  |  147 lines
  1. unit SysIconU;
  2.  
  3. interface
  4.  
  5. {$ifdef Ver90} { Delphi 2.0x }
  6.   {$define DelphiLessThan3}
  7.   {$define DelphiLessThan4}
  8. {$endif}
  9. {$ifdef Ver93} { C++ Builder 1.0x }
  10.   {$define DelphiLessThan3}
  11.   {$define DelphiLessThan4}
  12. {$endif}
  13. {$ifdef Ver100} { Delphi 3.0x }
  14.   {$define DelphiLessThan4}
  15. {$endif}
  16. {$ifdef Ver110} { C++ Builder 3.0x }
  17.   {$define DelphiLessThan4}
  18. {$endif}
  19.  
  20. uses
  21. {$ifndef DelphilessThan4}
  22.   ImgList,
  23. {$endif}
  24.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  25.   StdCtrls, ExtCtrls, ShellAPI;
  26.  
  27. type
  28.   TForm1 = class(TForm)
  29.     chkActive: TCheckBox;
  30.     ImageList: TImageList;
  31.     Timer: TTimer;
  32.     procedure FormCreate(Sender: TObject);
  33.     procedure FormDestroy(Sender: TObject);
  34.     procedure TimerTimer(Sender: TObject);
  35.     procedure chkActiveClick(Sender: TObject);
  36.   private
  37.     Bmp: TBitmap;
  38.     Icon: TIcon;
  39.     TextWidth,
  40.     DrawOffset: Integer;
  41.     procedure ScrollText;
  42.     procedure ImgListToSysTray(Operation: DWord);
  43.   end;
  44.  
  45. var
  46.   Form1: TForm1;
  47.  
  48. implementation
  49.  
  50. {$R *.DFM}
  51.  
  52. {$ifdef DelphiLessThan3}
  53. function Win32Check(RetVal: Bool): Bool;
  54. begin
  55.   if not RetVal then
  56.     raise Exception.Create(SysErrorMessage(GetLastError));
  57.   Result := RetVal;
  58. end;
  59. {$endif}
  60.  
  61. const
  62.   ScrollingText = 'The Delphi Clinic, only in The Delphi Magazine.';
  63.  
  64. procedure TForm1.ScrollText;
  65. begin
  66.   //Refill bitmap with white
  67.   Bmp.Canvas.FillRect(Rect(0, 0, Bmp.Width, Bmp.Height));
  68.   //Draw text from starting offset
  69.   Bmp.Canvas.TextOut(DrawOffset, 0, ScrollingText);
  70.   //Move offset leftwards
  71.   Dec(DrawOffset, 2);
  72.   if DrawOffset <= -Textwidth then
  73.     //If at end of text, reset offset
  74.     DrawOffSet := Bmp.Width;
  75.   ImgListToSysTray(NIM_MODIFY);
  76. end;
  77.  
  78. procedure TForm1.ImgListToSysTray(Operation: DWord);
  79. const
  80.   ClinicID = 100;
  81. var
  82.   BmpIndex: Integer;
  83.   NID: TNotifyIconData;
  84. begin
  85.   //Clear image list and add bitmap, with background made transparent
  86.   ImageList.Clear;
  87.   BmpIndex := ImageList.AddMasked(Bmp, Bmp.Canvas.Brush.Color);
  88.   ImageList.GetIcon(BmpIndex, Icon);
  89.  
  90.   //Setup TNotifyIconData record
  91.   FillChar(NID, SizeOf(NID), 0); //Clear record
  92.   NID.cbSize := SizeOf(NID); //Set byte count field
  93.   NID.Wnd := Handle; //Set owner
  94.   NID.uID := ClinicID; //Set icon ID
  95.   NID.uFlags := NIF_ICON or NIF_TIP; //Identify which other fields are valid
  96.   NID.hICon := Icon.Handle; //set icon handle
  97.   NID.szTip := 'The Delphi Clinic System Tray Text Scroller'; //Set tooltip
  98.  
  99.   //Set icon in system tray
  100.   Win32Check(Shell_NotifyIcon(Operation, @NID));
  101. end;
  102.  
  103. procedure TForm1.FormCreate(Sender: TObject);
  104. begin
  105.   //Create icon
  106.   Icon := TIcon.Create;
  107.  
  108.   //Set up bitmap
  109.   Bmp := TBitmap.Create;
  110.   Bmp.Width := GetSystemMetrics(SM_CXSMICON);
  111.   Bmp.Height := GetSystemMetrics(SM_CYSMICON);
  112.   Bmp.Canvas.Brush.Color := clWindow;
  113.   Bmp.Canvas.Font.Name := 'Verdana';
  114.   Bmp.Canvas.Font.Size := 10;
  115.   Bmp.Canvas.Font.Color := clWindowText;
  116.   TextWidth := Bmp.Canvas.TextWidth(ScrollingText);
  117.  
  118.   //Start text off at right-hand side of bitmap
  119.   DrawOffSet := Bmp.Width;
  120.  
  121.   //Set up image list
  122.   ImageList.Width := Bmp.Width;
  123.   ImageList.Height := Bmp.Height;
  124.  
  125.   ImgListToSysTray(NIM_ADD);
  126. end;
  127.  
  128. procedure TForm1.FormDestroy(Sender: TObject);
  129. begin
  130.   //Remove icon from system tray and tidy up
  131.   ImgListToSysTray(NIM_DELETE);
  132.   Bmp.Free;
  133.   Icon.Free;
  134. end;
  135.  
  136. procedure TForm1.TimerTimer(Sender: TObject);
  137. begin
  138.   ScrollText
  139. end;
  140.  
  141. procedure TForm1.chkActiveClick(Sender: TObject);
  142. begin
  143.   Timer.Enabled := chkActive.Checked
  144. end;
  145.  
  146. end.
  147.